# used libraries
if (!require("ggplot2")) install.packages("ggplot2")
if (!require("plotly")) install.packages("plotly")
# R package DT provides an R interface to the JavaScript library DataTables.
if (!require("DT")) install.packages("DT")
# geom_mark_hull
if (!require("concaveman")) install.packages("concaveman")
if (!require("ggforce")) install.packages("ggforce")


# more libraries
if (!require("listviewer")) install.packages("listviewer")
if (!require("lubridate")) install.packages("lubridate")
if (!require("forcats")) install.packages("forcats")
if (!require("maps")) install.packages("maps")
if (!require("mvtnorm")) install.packages("mvtnorm")
if (!require("gapminder")) install.packages("gapminder")
if (!require("hexbin")) install.packages("hexbin")
if (!require("Hmisc")) install.packages("Hmisc")
if (!require("GGally")) install.packages("GGally")

plotly - Documentation

This document is essentially a brief notes of the book above.

Bars & histograms

  • add_bars() - add bar plot
  • add_histogram() - add histogramm
    • plotly.js will do binning
    • can be compute and storage inefficient, use add_bar() with hist() or count() on large samples
p1 <- plot_ly(diamonds, x = ~price) %>%
  add_histogram(name = "plotly.js binning")

# what does function price_hist return?
price_hist <- function(method = "FD") {
  h <- hist(diamonds$price, breaks = method, plot = FALSE)
  plot_ly(x = h$mids, y = h$counts) %>% add_bars(name = method)
}

subplot(
  p1, price_hist(), price_hist("Sturges"),  price_hist("Scott"),
  nrows = 4, shareX = TRUE
)
# categorical
library(dplyr)
p1 <- plot_ly(diamonds, x = ~cut) %>%
  add_histogram()

p2 <- diamonds %>%
  count(cut) %>%
  plot_ly(x = ~cut, y = ~n) %>% 
  add_bars()

subplot(p1, p2) %>% hide_legend()

Multiple numeric distributions

# faking ggplot's facet_wrap() or facet_grid()
one_plot <- function(d) {
  plot_ly(d, x = ~price) %>%
    add_annotations(
      ~unique(clarity), x = 0.5, y = 1, 
      xref = "paper", yref = "paper", showarrow = FALSE
    )
}

diamonds %>%
  split(.$clarity) %>%
  lapply(one_plot) %>% 
  subplot(nrows = 2, shareX = TRUE, titleX = FALSE) %>%
  hide_legend()
## No trace type specified:
##   Based on info supplied, a 'histogram' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#histogram
## No trace type specified:
##   Based on info supplied, a 'histogram' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#histogram
## No trace type specified:
##   Based on info supplied, a 'histogram' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#histogram
## No trace type specified:
##   Based on info supplied, a 'histogram' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#histogram
## No trace type specified:
##   Based on info supplied, a 'histogram' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#histogram
## No trace type specified:
##   Based on info supplied, a 'histogram' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#histogram
## No trace type specified:
##   Based on info supplied, a 'histogram' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#histogram
## No trace type specified:
##   Based on info supplied, a 'histogram' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#histogram

Multiple discrete distributions

plot_ly(diamonds, x = ~cut, color = ~clarity) %>%
  add_histogram()

More details in https://plotly-r.com/bars-histograms.html

Boxplots

p <- plot_ly(diamonds, y = ~price, color = I("black"), 
             alpha = 0.1, boxpoints = "suspectedoutliers")
p1 <- p %>% add_boxplot(x = "Overall")
p2 <- p %>% add_boxplot(x = ~cut)
subplot(
  p1, p2, shareY = TRUE,
  widths = c(0.2, 0.8), margin = 0
) %>% hide_legend()
plot_ly(diamonds, x = ~price, y = ~interaction(clarity, cut)) %>%
  add_boxplot(color = ~clarity) %>%
  layout(yaxis = list(title = ""))
  • add_boxplot() - plotly.js will do statistics calculation
    • can be compute and storage inefficient, use precomputed
plot_ly(y = list(1,2,3,4,5,6,7,8,9), type = "box", q1=list(1, 2, 3), median=list(4, 5, 6),
                  q3=list(7, 8, 9 ), lowerfence=list(-1, 0, 1),
                  upperfence=list(5, 6, 7), mean=list(2.2, 2.8, 3.2 ),
                  sd=list(0.2, 0.4, 0.6), notchspan=list(0.2, 0.4, 0.6))

More on box plots https://plotly-r.com/boxplots.html, https://plotly.com/r/box-plots/.

2D Frequencies/Historgamms and Heatmap

  • add_heatmap() - plot a heatmap, similar to add_bar in 1-D
  • add_histogram2d() - plot a histogramm, plot.js do calculations
p <- plot_ly(diamonds, x = ~log(carat), y = ~log(price))
subplot(
  add_histogram2d(p) %>%
    colorbar(title = "default") %>%
    layout(xaxis = list(title = "default")), # default bins
  add_histogram2d(p, zsmooth = "best") %>%
    colorbar(title = "zsmooth") %>%
    layout(xaxis = list(title = "zsmooth")), # interpolation
  add_histogram2d(p, nbinsx = 60, nbinsy = 60) %>%
    colorbar(title = "nbins") %>%
    layout(xaxis = list(title = "nbins")), # manually more bins
  shareY = TRUE, titleX = TRUE
)
kde_count <- function(x, y, ...) {
  kde <- MASS::kde2d(x, y, ...)
  df <- with(kde, setNames(expand.grid(x, y), c("x", "y")))
  # The 'z' returned by kde2d() is a proportion, 
  # but we can scale it to a count
  df$count <- with(kde, c(z) * length(x) * diff(x)[1] * diff(y)[1])
  data.frame(df)
}

kd <- with(diamonds, kde_count(log(carat), log(price), n = 30))
plot_ly(kd, x = ~x, y = ~y, z = ~count) %>% 
  add_heatmap() %>%
  colorbar(title = "Number of diamonds")
# correlogram
# colors?
corr <- cor(dplyr::select_if(diamonds, is.numeric))
plot_ly(colors = "RdBu") %>%
  add_heatmap(x = rownames(corr), y = colnames(corr), z = corr) %>%
  colorbar(limits = c(-1, 1))
# draw random values from correlated bi-variate normal distribution
s <- matrix(c(1, 0.3, 0.3, 1), nrow = 2)
m <- mvtnorm::rmvnorm(1e5, sigma = s)
x <- m[, 1]
y <- m[, 2]
s <- subplot(
  plot_ly(x = x, color = I("black")), 
  plotly_empty(), 
  plot_ly(x = x, y = y, color = I("black")) %>%
    add_histogram2dcontour(colorscale = "Viridis"), 
  plot_ly(y = y, color = I("black")),
  nrows = 2, heights = c(0.2, 0.8), widths = c(0.8, 0.2), margin = 0,
  shareX = TRUE, shareY = TRUE, titleX = FALSE, titleY = FALSE
)
## No trace type specified:
##   Based on info supplied, a 'histogram' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#histogram
## No trace type specified:
##   Based on info supplied, a 'scatter' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#scatter
## No scatter mode specifed:
##   Setting the mode to markers
##   Read more about this attribute -> https://plotly.com/r/reference/#scatter-mode
## No trace type specified:
##   Based on info supplied, a 'histogram' trace seems appropriate.
##   Read more about this trace type -> https://plotly.com/r/reference/#histogram
layout(s, showlegend = FALSE)

more in https://plotly-r.com/frequencies-2d

3d charts

Markers

iris
plot_ly(iris, x = ~Sepal.Length, y = ~Sepal.Width, z = ~Petal.Length) %>%
  add_markers(color = ~Species)
# aren't symbols too big?

Interactions are different from 2D * left click - drag - rotate * middle click - drag or use mouse scroll-wheel -> scale/zoom * right click - drag - move * try ctlr+mouse buttons

Lines: * add_lines() * add_paths()

Surfaces * add_surface()

volcano[1:10,1:10]
##       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
##  [1,]  100  100  101  101  101  101  101  100  100   100
##  [2,]  101  101  102  102  102  102  102  101  101   101
##  [3,]  102  102  103  103  103  103  103  102  102   102
##  [4,]  103  103  104  104  104  104  104  103  103   103
##  [5,]  104  104  105  105  105  105  105  104  104   103
##  [6,]  105  105  105  106  106  106  106  105  105   104
##  [7,]  105  106  106  107  107  107  107  106  106   105
##  [8,]  106  107  107  108  108  108  108  107  107   106
##  [9,]  107  108  108  109  109  109  109  108  108   107
## [10,]  108  109  109  110  110  110  110  109  109   108
x <- seq_len(nrow(volcano)) + 100
y <- seq_len(ncol(volcano)) + 500
plot_ly() %>% add_surface(x = ~x, y = ~y, z = ~volcano)

more in https://plotly-r.com/d-charts.html

Maps

  • Integrated maps
    • Mapbox powered basemap
    • Integrated d3.js powered basemap
  • Custom maps
# simple latitude/longitude data
head(maps::us.cities)
p <- plot_mapbox(maps::us.cities) %>%
  add_markers(
    x = ~long, 
    y = ~lat, 
    size = ~pop, 
    color = ~country.etc,
    colors = "Accent",
    text = ~paste(name, pop),
    hoverinfo = "text"
  )
p
Error: No mapbox access token found. Obtain a token here
https://www.mapbox.com/help/create-api-access-token/
Once you have a token, assign it to an environment variable 
named 'MAPBOX_TOKEN', for example,
Sys.setenv('MAPBOX_TOKEN' = 'secret token')

Need mapbox account

Regester with map box and add to .Renviron in your Documents folder:
MAPBOX_TOKEN="magic.token"


schema()$layout$layoutAttributes$mapbox$style$values
##  [1] "basic"             "streets"           "outdoors"         
##  [4] "light"             "dark"              "satellite"        
##  [7] "satellite-streets" "carto-darkmatter"  "carto-positron"   
## [10] "open-street-map"   "stamen-terrain"    "stamen-toner"     
## [13] "stamen-watercolor" "white-bg"
p %>% layout(
  mapbox = list(style = "satellite")
)
# integrated plotly.js dropdown menu to control the basemap style
styles <- schema()$layout$layoutAttributes$mapbox$style$values
style_buttons <- lapply(styles, function(s) {
  list(
    label = s, 
    method = "relayout", 
    args = list("mapbox.style", s)
  )
})
layout(
  p, 
  mapbox = list(style = "dark"),
  updatemenus = list(
    list(y = 0.8, buttons = style_buttons)
  )
)
# same with plot_geo()
p <- plot_geo(maps::us.cities) %>%
  add_markers(
    x = ~long, 
    y = ~lat, 
    size = ~pop, 
    color = ~country.etc,
    colors = "Accent",
    text = ~paste(name, pop),
    hoverinfo = "text"
  )
p
p %>% layout(
  geo = list(
    projection = list(
      type = 'orthographic',
      rotation = list(lon = -100, lat = 40, roll = 0)
    ),
    showland = TRUE,
    landcolor = toRGB("gray95"),
    countrycolor = toRGB("gray80")
  ), 
  showlegend = FALSE)

plot_mapbox uses only mercator projection, while plot_geo support more.

Use add_line(), add_path(), add_segments() on them.

Choropleths

density <- state.x77[, "Population"] / state.x77[, "Area"]
density
##        Alabama         Alaska        Arizona       Arkansas     California 
##   0.0712905261   0.0006443845   0.0195032491   0.0406198864   0.1355708904 
##       Colorado    Connecticut       Delaware        Florida        Georgia 
##   0.0244877898   0.6375976964   0.2921291625   0.1530227399   0.0849103714 
##         Hawaii          Idaho       Illinois        Indiana           Iowa 
##   0.1350972763   0.0098334482   0.2008502547   0.1471867468   0.0511431687 
##         Kansas       Kentucky      Louisiana          Maine       Maryland 
##   0.0278772910   0.0854224464   0.0847095482   0.0342173351   0.4167424932 
##  Massachusetts       Michigan      Minnesota    Mississippi       Missouri 
##   0.7429082545   0.1603569354   0.0494520047   0.0494967862   0.0690919632 
##        Montana       Nebraska         Nevada  New Hampshire     New Jersey 
##   0.0051240839   0.0201874926   0.0053690542   0.0899523651   0.9750033240 
##     New Mexico       New York North Carolina   North Dakota           Ohio 
##   0.0094224624   0.3779139052   0.1115004713   0.0091955019   0.2619890177 
##       Oklahoma         Oregon   Pennsylvania   Rhode Island South Carolina 
##   0.0394725364   0.0237461532   0.2637548370   0.8875119161   0.0931679074 
##   South Dakota      Tennessee          Texas           Utah        Vermont 
##   0.0089658350   0.1009727062   0.0466822312   0.0146535763   0.0509334197 
##       Virginia     Washington  West Virginia      Wisconsin        Wyoming 
##   0.1252136752   0.0534625207   0.0747403407   0.0842574912   0.0038681934
g <- list(
  scope = 'usa',
  projection = list(type = 'albers usa'),
  lakecolor = toRGB('white')
)

plot_geo() %>%
  add_trace(
    z = ~density, text = state.name, span = I(0),
    locations = state.abb, locationmode = 'USA-states'
  ) %>%
  layout(geo = g)
plot_ly() %>%
  add_trace(
    type = "choroplethmapbox",
    # See how this GeoJSON URL was generated at
    # https://plotly-r.com/data-raw/us-states.R
    geojson = paste(c(
      "https://gist.githubusercontent.com/cpsievert/",
      "7cdcb444fb2670bd2767d349379ae886/raw/",
      "cf5631bfd2e385891bb0a9788a179d7f023bf6c8/", 
      "us-states.json"
    ), collapse = ""),
    locations = row.names(state.x77),
    z = state.x77[, "Population"] / state.x77[, "Area"],
    span = I(0)
  ) %>%
  layout(
    mapbox = list(
      style = "light",
      zoom = 4,
      center = list(lon = -98.58, lat = 39.82)
    )
  ) %>%
  config(
    mapboxAccessToken = Sys.getenv("MAPBOX_TOKEN"),
    # Workaround to make sure image download uses full container
    # size https://github.com/plotly/plotly.js/pull/3746
    toImageButtonOptions = list(
      format = "svg", 
      width = NULL, 
      height = NULL
    )
  )

more in https://plotly-r.com/maps.html, in particular check sf package

Animation

  • Additional dimension
  • Supported through frame argument/aesthetic. use ids for smother transitions.
data(gapminder, package = "gapminder")
gg <- ggplot(gapminder, aes(gdpPercap, lifeExp, color = continent)) +
  geom_point(aes(size = pop, frame = year, ids = country)) +
  scale_x_log10()
ggplotly(gg)

character variables is alphabet ordered, factors are level ordered

meanLife <- with(gapminder, tapply(lifeExp, INDEX = continent, mean))
gapminder$continent <- factor(
  gapminder$continent, levels = names(sort(meanLife))
)

# some times smooth transition does not have sence
gapminder %>%
  plot_ly(x = ~gdpPercap, y = ~lifeExp, size = ~pop, 
          text = ~country, hoverinfo = "text") %>%
  layout(xaxis = list(type = "log")) %>%
  add_markers(data = gapminder, frame = ~continent) %>%
  hide_legend() %>%
  animation_opts(frame = 1000, transition = 0)
gapminder %>%
  plot_ly(x = ~gdpPercap, y = ~lifeExp, size = ~pop, 
          text = ~country, hoverinfo = "text") %>%
  layout(xaxis = list(type = "log")) %>%
  add_markers(
    color = ~continent, showlegend = F,
    alpha = 0.2, alpha_stroke = 0.2
  ) %>%
  add_markers(color = ~continent, frame = ~year, ids = ~country) %>%
  animation_opts(1000, redraw = FALSE)

Not all traces support animation

More in https://plotly-r.com/animating-views.html

Artificial Intelligence and Machine Learning

see https://plotly.com/r/ai-ml/

Generalized pairs plot

pm <- GGally::ggpairs(iris, aes(color = Species))
## Registered S3 method overwritten by 'GGally':
##   method from   
##   +.gg   ggplot2
class(pm)
## [1] "gg"       "ggmatrix"
#> [1] "gg"  "ggmatrix"
ggplotly(pm)
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Summary

Creating plotly object

  • plot_ly()/plot_geo()/plot_mapbox() - main plotly.R access functions
  • ggplotly() - convert ggplot
  • plotly_build() - convert list (don’t do it, unless you know why you want it)

Specifying actial (fixed) property

  • Use I(<value>) to specify color, mark and similar

Use chaining with %>%. It is graphic gramma of plotly.R and it produce more readable code.

add_*() functions:

  • add_histogram2d(), add_contour(), add_boxplot(,… - add specific type of trace

subplot() - make subplot.

WebGL is a lot more efficient at rendering lots of points, try toWebGL().

Tips and Tricks

Plot widths.

Interaction section: please tell me how! Following will work in html output:

  • out.width - does not help
  • argument width = 1200 does not affect large view.
library(plotly)
p <- ggplot(mpg, aes(displ, hwy)) + geom_point()
ggplotly(p)
library(plotly)
p <- ggplot(mpg, aes(displ, hwy)) + geom_point()
ggplotly(p, width = 1200)
  • change whole document width:
in R mardown file:
output:
  html_document:
    css: doc.css

in doc.css file:
div.main-container {
  max-width: 1600px !important;
}